{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE EmptyDataDecls        #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE RankNTypes    #-}
module Language.Map.MapPretty where

import Language.Map.Map

import Generics.MultiRec.Base
import Generics.MultiRec.Show as GS
import Generics.MultiRec.Zipper 
import Generics.MultiRec.TH.Alt
import Data.Maybe
import Data.Dynamic
import Data.Typeable

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Pos
import Text.ParserCombinators.Parsec.Prim
import Text.ParserCombinators.Parsec.Token

import Unsafe.Coerce


-- ** Parser

entryP :: Parser Entry
entryP = do 
          many space
          srcFrom <- getPosition
          char '('
          many space
          c <- letter
          many space
          char ','
          many space
          i <- natParser
          many space
          char ')'
          srcTo <- getPosition
          many space
          return (E c i (SrcSpan srcFrom srcTo))

innerEntry :: Parser Entry
innerEntry = do 
               many space
               char ','
               e <- entryP
               return e

mappP :: Parser Map
mappP = (do
         many space
         srcFrom <- getPosition
         many space
         e <- innerEntry <|> entryP
         many space
         m <- mappP
         many space
         srcTo <- getPosition
         many space
         return (Cons e m (SrcSpan srcFrom srcTo))
       <|> do 
             p <- getPosition
             return (Empty (SrcSpan p p)))

mapList :: Parser Map
mapList = do
            many space
            srcFrom <- getPosition
            char '['
            m <- mappP
            char ']'
            srcTo <- getPosition
            return (setSrcSpan m (SrcSpan srcFrom srcTo))

setSrcSpan :: Map -> SourceSpan -> Map
setSrcSpan (Cons e m _) srcSpan = (Cons e m srcSpan)
setSrcSpan _            srcSpan = (Empty srcSpan)

